home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGASIC / BASFILES.LZH / SCROLBOX.BAS < prev    next >
BASIC Source File  |  1988-09-10  |  6KB  |  290 lines
  1. '$INCLUDE:'QBTOOLS.INC'
  2. '' '$INCLUDE: 'qbtools2.inc'
  3.  
  4. 'DIM Sc$(300)
  5. 'ct% = 0
  6.  
  7. 'FOR j% = 1 TO 300
  8. '   ct% = ct% + 1
  9. '
  10. '   IF ct% > 26 THEN
  11. '      ct% = 0
  12. '   END IF
  13. '
  14. '   Sc$(j%) = CHR$(64 + ct%) + " Test" + STR$(j%)
  15. 'NEXT j%
  16.  
  17. 'wd% = 10
  18. 'Hg% = 9
  19. 'bx% = 10
  20. 'by% = 5
  21. 'fc% = 7
  22. 'tf% = 7
  23. 'gb% = 0
  24. 'hb% = 7
  25. 'hf% = 0
  26. 'ss% = 1
  27. 'El% = 100
  28. 'Aesc% = 1
  29. 'Atb% = 1
  30. 'Af10% = 1
  31. 'Rv% = 57
  32.  
  33. 'ScrollBox Sc$(), wd%, Hg%, bx%, by%, fc%, tf%, gb%, hb%, hf%, ss%, El%, Aesc%, Atb%, Af10%, Rv%, Rst$, GlbErr%
  34.  
  35. '
  36. '  New Scroll Box
  37. '
  38. '  Passed Values
  39. '     Rv%   .. if it's set, then the box will Start display at that point
  40. '     Atb%  .. if =1 then allows Tab
  41. '     Af10% .. if =1 then allows F10 to be pressed
  42. '
  43. '  On return...
  44. '
  45. '     If Rv% = -1% then Af10% (F10) was pressed
  46. '     If Rv% > El% then TAB was pressed (Use Rv%=Rv%-El%) to get the proper Rv%
  47. '
  48. '
  49.  
  50. SUB ScrollBox (sc$(), wd%, hg%, bx%, by%, fc%, Tf%, Gb%, Hbgd%, Hf%, ss%, el%, Ok%(), rv%, rst$, GlbErr%) STATIC
  51.  
  52.     REDIM scsav%(2000)                           '  Screen save
  53.  
  54.     ExKeys% = UBOUND(Ok%, 1)                     '  Exit Keys
  55.  
  56.     GlbErr% = 0                                  '  Initialize the error msg
  57.     rh% = hg% + 2                                '  Real height (with frame)
  58.     rw% = wd% + 2                                '  Real width (with frame)
  59.     chkx% = bx% + rw% - 1                        '  Check for overflow
  60.  
  61.     IF chkx% > 80 THEN
  62.         GlbErr% = 1                               '  Frame too wide
  63.         EXIT SUB
  64.     END IF
  65.  
  66.     chky% = rh% + by% - 1                        '  Check for overflow
  67.  
  68.     IF chky% > 24 THEN
  69.         GlbErr% = 2                               '  Frame too tall
  70.         EXIT SUB
  71.     END IF
  72.  
  73.     Col1% = Attributes%(fc%, Gb%, 0, 0)
  74.     Col2% = Attributes%(Tf%, Gb%, 0, 0)
  75.     Col3% = Attributes%(Hf%, Hbgd%, 0, 0)
  76.  
  77.     IF ss% = 1 THEN                              '  Save the screen
  78.         GetScreen scsav%(0), by%, bx%, chky%, chkx%                                                                                                '  Fastest
  79.     END IF
  80.  
  81.                                                                 '  Draw the box first
  82.                                                                 '  This version uses only the
  83.                                                                 '  narrow single drawing char.
  84.   
  85.     ColorPrint CHR$(218) + STRING$(wd%, 196) + CHR$(191), by%, bx%, Col1% '  Top line
  86.  
  87.     FOR j% = by% + 1 TO chky% - 1                '  Loop through....
  88.         ColorPrint CHR$(179), j%, bx%, Col1%      '  Print the left border
  89.         ColorPrint CHR$(179), j%, chkx%, Col1%    '  Print the right border
  90.     NEXT j%
  91.  
  92.     ColorPrint CHR$(192) + STRING$(wd%, 196) + CHR$(217), chky%, bx%, Col1%
  93.  
  94.     IF rv% > el% THEN
  95.         rv% = el%
  96.     END IF
  97.  
  98.     Sv% = 1                                      '  Where highlit value starts
  99.     Tv% = 1                                      '  Where current value is
  100.  
  101.     IF Tv% < rv% THEN
  102.         Tv% = rv%
  103.         Sv% = Tv%
  104.     END IF
  105.  
  106.     scex% = 0                                    '  Do not exit
  107.     WHILE scex% = 0                              '  While at this value
  108.  
  109.         FOR j% = 1 TO hg%                         '  Display this many lines
  110.  
  111.             IF (j% - 1 + Tv%) > el% THEN
  112.                 text$ = STRING$(wd%, 32)
  113.             ELSE
  114.                 text$ = sc$(j% - 1 + Tv%)           '  Set the text equal value
  115.             END IF
  116.  
  117.             IF LEN(text$) < wd% THEN               '  Too small
  118.                 text$ = text$ + STRING$(wd% - LEN(text$), 32)
  119.             END IF
  120.  
  121.             IF LEN(text$) > wd% THEN
  122.                 text$ = LEFT$(text$, wd%)
  123.             END IF
  124.  
  125.             IF (j% - 1 + Tv%) = Sv% THEN
  126.                 ColorPrint text$, j% + by%, bx% + 1, Col3%
  127.             ELSE
  128.                 ColorPrint text$, j% + by%, bx% + 1, Col2%
  129.             END IF
  130.  
  131.         NEXT j%
  132.  
  133.         w$ = ""
  134.         WHILE w$ = ""
  135.             w$ = INKEY$
  136.         WEND
  137.  
  138.         IF LEN(w$) = 1 THEN
  139.             Ch% = ASC(w$)
  140.  
  141.             SELECT CASE Ch%
  142.              
  143.                 CASE 9
  144.                     IF ExKeys% >= 42 THEN
  145.                         IF Ok%(42) = 1 THEN
  146.                             rv% = -42
  147.                             rst$ = sc$(Sv%)
  148.                             scex% = 1
  149.                         END IF
  150.                     END IF
  151.  
  152.                 CASE 13
  153.                     rv% = Sv%
  154.                     rst$ = sc$(Sv%)
  155.                     scex% = 1
  156.               
  157.                 CASE 27
  158.                     IF ExKeys% > 40 THEN
  159.                         IF Ok%(41) = 1 THEN
  160.                             rv% = -41
  161.                             rst$ = ""
  162.                             scex% = 1
  163.                         END IF
  164.                     END IF
  165.  
  166.                 CASE ELSE
  167.                     Np% = 0
  168.                                       
  169.                     FOR k% = Sv% + 1 TO el%
  170.                         IF UCASE$(LEFT$(sc$(k%), 1)) = UCASE$(CHR$(Ch%)) THEN
  171.                             Np% = k%
  172.                             EXIT FOR
  173.                         END IF
  174.                     NEXT k%
  175.                   
  176.                     IF Np% = 0 THEN
  177.                         FOR k% = 1 TO Sv% - 1
  178.                             IF UCASE$(LEFT$(sc$(k%), 1)) = UCASE$(CHR$(Ch%)) THEN
  179.                                 Np% = k%
  180.                                 EXIT FOR
  181.                             END IF
  182.                         NEXT k%
  183.                     END IF
  184.                   
  185.                     IF Np% THEN
  186.                         Tv% = Np%
  187.                         Sv% = Tv%
  188.                     END IF
  189.                   
  190.                     Np% = 0
  191.               
  192.                     IF Sv% > el% THEN
  193.                         Sv% = el%
  194.                         Tv% = (Sv% - hg%) + 1
  195.                         IF Tv% < 1 THEN
  196.                             Tv% = 1
  197.                         END IF
  198.                     END IF
  199.  
  200.             END SELECT
  201.  
  202.         ELSE
  203.             Ch% = ASC(MID$(w$, 2))
  204.  
  205.             IsFunction% = CheckFunction%(Ch%)
  206.  
  207.             IF IsFunction% THEN
  208.                 IF ExKeys% >= IsFunction% THEN
  209.                     IF Ok%(IsFunction%) THEN
  210.                         rv% = -IsFunction%
  211.                         scex% = 1
  212.                     END IF
  213.                 END IF
  214.             END IF
  215.  
  216.             IF Ch% = 72 THEN                       '  Up arrow
  217.                 Sv% = Sv% - 1
  218.  
  219.                 IF Sv% < Tv% THEN
  220.                     Tv% = Tv% - 1
  221.                 END IF
  222.  
  223.                 IF Sv% = 0 THEN
  224.                     Sv% = 1
  225.                 END IF
  226.  
  227.                 IF Tv% = 0 THEN
  228.                     Tv% = 1
  229.                 END IF
  230.  
  231.             END IF
  232.  
  233.             IF Ch% = 80 THEN                       '  Down arrow
  234.                 IF Sv% < el% THEN
  235.                     Sv% = Sv% + 1
  236.                     IF (Tv% + hg% - 1) < Sv% THEN
  237.                         Tv% = Tv% + 1
  238.                     END IF
  239.                 END IF
  240.             END IF
  241.  
  242.             IF Ch% = 71 THEN                       '  Home
  243.                 Sv% = 1
  244.                 Tv% = 1
  245.             END IF
  246.  
  247.             IF Ch% = 79 THEN                       '  End
  248.                 Sv% = el%
  249.                 Tv% = (Sv% - hg%) + 1
  250.                 IF Tv% < 1 THEN
  251.                     Tv% = 1
  252.                 END IF
  253.             END IF
  254.  
  255.             IF Ch% = 81 THEN                       '  Page down
  256.                 Sv% = Sv% + hg%
  257.                 Tv% = Tv% + hg%
  258.                 IF el% < (Tv% + hg%) - 1 AND ((Sv% - Tv%) + 1) < hg% THEN
  259.                     Tv% = (Sv% - hg%) + 1
  260.                 END IF
  261.                 IF Sv% > el% THEN
  262.                     Sv% = el%
  263.                     Tv% = (Sv% - hg%) + 1
  264.                     IF Tv% < 1 THEN
  265.                         Tv% = 1
  266.                     END IF
  267.                 END IF
  268.             END IF
  269.  
  270.             IF Ch% = 73 THEN                       '  Page up
  271.                 Sv% = Sv% - hg%
  272.                 Tv% = Tv% - hg%
  273.                 IF Tv% < 1 THEN
  274.                     IF Sv% < 1 THEN
  275.                         Sv% = 1
  276.                     END IF
  277.                     Tv% = 1
  278.                 END IF
  279.             END IF
  280.  
  281.         END IF
  282.     WEND
  283.  
  284.     IF ss% = 1 THEN                              '  Save the screen
  285.         PutScreen scsav%(0), by%, bx%, chky%, chkx%                                                                                                 '  Fastest
  286.     END IF
  287.  
  288.   END SUB
  289.  
  290.